www.gusucode.com > 地方成人教育中心整站源代码 1 > 地方成人教育中心整站源代码 1.0/bbs/inc/Ubblist.asp
<% Function Ubblist(Str1) Dim Str Str=Str1 Str=LCase(Str) Dim Dv_ubb(54),i Dv_ubb(0)="javascript":Dv_ubb(1)="jscript:":Dv_ubb(2)="js:":Dv_ubb(3)="value":Dv_ubb(4)="about:" Dv_ubb(5)="file:":Dv_ubb(6)="document.cookie":Dv_ubb(7)="vbscript:":Dv_ubb(8)="vbs:":Dv_ubb(9)="mouse" Dv_ubb(10)="exit":Dv_ubb(11)="error":Dv_ubb(12)="click":Dv_ubb(13)="key":Dv_ubb(14)="[/img]" Dv_ubb(15)="[/upload]":Dv_ubb(16)="[/dir]":Dv_ubb(17)="[/qt]":Dv_ubb(18)="[/mp]":Dv_ubb(19)="[/rm]" Dv_ubb(20)="[/sound]":Dv_ubb(21)="[/flash]":Dv_ubb(22)="[/money]":Dv_ubb(23)="[/point]":Dv_ubb(24)="[/usercp]" Dv_ubb(25)="[/power]":Dv_ubb(26)="[/post]":Dv_ubb(27)="[/replyview]":Dv_ubb(28)="[/usemoney]":Dv_ubb(29)="[/url]" Dv_ubb(30)="[/email]":Dv_ubb(31)="http":Dv_ubb(32)="https":Dv_ubb(33)="ftp":Dv_ubb(34)="rtsp":Dv_ubb(35)="mms" Dv_ubb(36)="[/html]":Dv_ubb(37)="[/code]":Dv_ubb(38)="[/color]":Dv_ubb(39)="[/face]":Dv_ubb(40)="[/align]" Dv_ubb(41)="[/quote]":Dv_ubb(42)="[/fly]":Dv_ubb(43)="[/move]":Dv_ubb(44)="[/shadow]":Dv_ubb(45)="[/glow]" Dv_ubb(46)="[/size]":Dv_ubb(47)="[/i]":Dv_ubb(48)="[/b]":Dv_ubb(49)="[/u]":Dv_ubb(50)="[em":Dv_ubb(51)="www.":Dv_ubb(52)="[/payto]" Dv_ubb(53)="[/username]":Dv_ubb(54)="[/center]" Ubblist="," '检查脚本标记0 For i=0 to 13 If InStr(Str,Dv_ubb(i))>0 Or InStr(Str,"&#")>0 or InStr(Str,"button") Then Ubblist=Ubblist&"0," Exit For End If Next 'Response.Write "Ubblist:<br>" For i=14 to 54 If InStr(Str,Dv_ubb(i))>0 Then If i >= 52 Then Ubblist=Ubblist & i-12 &"," Else Ubblist=Ubblist & i-13 &"," End If End If 'Response.Write Dv_ubb(i)&"编号:"&i-13&"." Next Ubblist=Ubblist & "39," If istext(Str1) Then Ubblist=Ubblist&"istext," End If If xhtml(Str1) Then Ubblist=Ubblist&"xhtml," Exit Function End If Dim TmpStr '去掉字符串中的空格 If IsNull(Str) Then Exit Function TmpStr=Replace(Str," ","") TmpStr=Replace(TmpStr," ","") TmpStr=Replace(TmpStr,Chr(10),"") TmpStr=Replace(TmpStr,Chr(13),"") 'Ubblist=Ubblist&fixtable(TmpStr,"table")'&fixtable(TmpStr,"td")&fixtable(TmpStr,"th")&fixtable(TmpStr,"tr") Ubblist=Ubblist&checkTable(TmpStr) End Function Function istext(Str) Dim text,text1 text=Str text1=Str If text1=Dvbbs.Replacehtml(text) Then istext=True End If End Function '检查表格 Function fixtable(Str,flag) Dim bodyStr bodyStr=Str If bodyStr<>"" Then Dim instr1,instr2 Dim Str1,Str2,newstr1,newstr2 Str2="</"&flag&">" Str1="<"&flag Instr1=InStr(bodyStr,str1) Instr2=InStr(bodyStr,Str2) If Instr1 >0 And Instr2>0 Then If Instr1 > Instr2 Then fixtable=flag&"," Exit Function Else newstr1=Mid(bodyStr,InStr2+Len(Str2),Len(bodyStr)-(instr2+Len(Str2)-instr1)) Newstr2=Mid(bodyStr,InStr1+Len(Str1),instr2-instr1-Len(str2)+2) fixtable=fixtable(newstr1,flag)&fixtable(newstr2,flag) End If ElseIf Instr1 =0 And Instr2=0 Then Exit Function ElseIf Instr1 >0 And Instr2=0 Then fixtable=flag&"," Exit Function ElseIf Instr1 =0 And Instr2>0 Then fixtable=flag&"," Exit Function End If Else fixtable="" End If End Function Function UbblistOLD(Str) UbblistOLD=Ubblist(Str) UbblistOLD=Replace(UbblistOLD,"39,","") End Function Function checkTable(tablestr) checkTable="" Dim s,tmpstr1,tmpstr2 s=tablestr tmpstr1=split(s,"<table") tmpstr2=split(s,"</table>") If UBound(tmpstr1)<>UBound(tmpstr2) Then checkTable=checkTable&"table," End If tmpstr1=split(s,"<td") tmpstr2=split(s,"</td>") If UBound(tmpstr1)<>UBound(tmpstr2) Then checkTable=checkTable&"td," End If tmpstr1=split(s,"<div") tmpstr2=split(s,"</div>") If UBound(tmpstr1)<>UBound(tmpstr2) Then checkTable=checkTable&"tr," End If tmpstr1=split(s,"<th") tmpstr2=split(s,"</th>") If UBound(tmpstr1)<>UBound(tmpstr2) Then checkTable=checkTable&"th," End If End Function Function CheckAlipay() Dim seller,subject,price,transport,mail,express,demo,ww,qq,message,api_key seller = Request.Form("alipay_seller") subject = Request.Form("alipay_subject") message = unescape(Request.Form("body")) price = Request.Form("alipay_price") transport = Request.Form("ialipay_transport") mail = Request.Form("alipay_mail") express = Request.Form("alipay_express") demo = Request.Form("alipay_demo") ww = Request.Form("alipay_ww") qq = Request.Form("alipay_qq") 'api_key = Request.Form("alipay_key") If seller = "@" Or seller = "" Or subject = "" Or (Not IsNumeric(price)) Or message = "" Then CheckAlipay = "" Exit Function End If CheckAlipay = "[payto]" CheckAlipay = CheckAlipay & "(seller)"&seller&"(/seller)" CheckAlipay = CheckAlipay & "(subject)"&subject&"(/subject)" CheckAlipay = CheckAlipay & "(body)"&message&"(/body)" CheckAlipay = CheckAlipay & "(price)"&price&"(/price)" CheckAlipay = CheckAlipay & "(transport)"&transport&"(/transport)" If mail <> "" And IsNumeric(mail) Then CheckAlipay = CheckAlipay & "(ordinary_fee)"&mail&"(/ordinary_fee)" If express <> "" And IsNumeric(express) Then CheckAlipay = CheckAlipay & "(express_fee)"&express&"(/express_fee)" If demo <> "" And Not Lcase(demo) = "http://" Then CheckAlipay = CheckAlipay & "(demo)"&demo&"(/demo)" If ww <> "" Then CheckAlipay = CheckAlipay & "(ww)"&ww&"(/ww)" If qq <> "" Then CheckAlipay = CheckAlipay & "(qq)"&qq&"(/qq)" 'If api_key<>"" Then CheckAlipay = CheckAlipay & "(key)"&api_key&"(/key)" CheckAlipay = CheckAlipay & "[/payto]" CheckAlipay = Dvbbs.CheckStr(CheckAlipay) End Function Function xhtml(Str) Dim xml Set xml=Dvbbs.iCreateObject("msxml2.DOMDocument"& MsxmlVersion) xhtml= xml.loadxml("<xml>" & xmlencode(Str) &"</xml>") End Function Function xmlencode(Str) Dim s,i s=Str S=replace(S,"&","&") For i=0 to 31 S=Replace(S,Chr(i),"&#"&i&";") Next For i=95 to 96 S=Replace(S,Chr(i),"&#"&i&";") Next xmlencode=S End Function Function Rexmlencode(Str) Dim i Str=replace(Str,"&","&") For i=0 to 31 Str=Replace(Str,"&#"&i&";",Chr(i)) Next For i=95 to 96 Str=Replace(Str,"&#"&i&";",Chr(i)) Next Rexmlencode=Str End Function %>